home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IOInterface / windowOpen.icl < prev   
Encoding:
Modula Implementation  |  1997-04-23  |  7.7 KB  |  198 lines  |  [TEXT/3PRM]
  1. implementation module windowOpen;
  2.  
  3. import StdClass,StdInt,StdBool;
  4. import    windows, quickdraw;
  5. import    commonDef, windowInternal, windowAccess;
  6. from    deltaWindow        import CloseWindows;
  7. from    deltaPicture    import EraseRectangle;
  8.  
  9. from StdMisc import abort;
  10.  
  11. CleanWindowRefCon    :== 1;
  12.  
  13. WindowOpenError :: String String -> * x;
  14. WindowOpenError rule error = Error rule "windowOpen" error;
  15.  
  16. OpenWindow :: !(DeviceSystem s (IOState s)) !(IOState s) -> IOState s;
  17. OpenWindow (WindowSystem wDefs) ioState
  18.     =    IOStateSetDevice (IOStateSetToolbox tb1 ioState1) (WindowSystemState (windows, NoGlobalCursor));
  19.     where {
  20.         (windows, tb1) = Open_windows (-1) wDefs [] tb;
  21.         (tb, ioState1) = IOStateGetToolbox ioState;
  22.         };
  23. OpenWindow noWindowSystem _
  24.     =    WindowOpenError "OpenWindow" "argument is no WindowSystem";
  25.     
  26. Open_windows :: !WindowPtr ![WindowDef s (IOState s)] ![WindowHandle s] !Toolbox
  27.     ->    (![WindowHandle s],!Toolbox);
  28. Open_windows behind [wDef : wDefs] wHs tb
  29. |    exists                                = Open_windows behind wDefs wHs tb1;
  30. |    WindowDefHasAttribute wDef goAway    = Open_windows behind wDefs [wH : wHs] tb2;
  31.                                         = Open_windows behind wDefs [(wDef2, window) : wHs] tb2;
  32.     where {
  33.         (exists, tb1)    = ActivateThisWindow behind wHs id tb;
  34.         (wH,tb2)        = Open_window wDef behind tb1;
  35.         (wDef1, window)    = wH;
  36.         wDef2            = WindowDefSetGoAway f wDef1;
  37.         goAway            = GoAway f;
  38.         id                = WindowDefGetWindowId wDef;
  39.         f                = CloseThisWindow id;
  40.     };
  41. Open_windows _ _ wHs tb = (wHs, tb);
  42.  
  43. CloseThisWindow :: !WindowId !*s !(IOState *s) -> (!*s, !IOState *s);
  44. CloseThisWindow id s ioState = (s, CloseWindows [id] ioState);
  45.  
  46. ActivateThisWindow :: !WindowPtr ![WindowHandle s] !WindowId !Toolbox -> (!Bool, !Toolbox);
  47. ActivateThisWindow behind [wH : wHs] id tb
  48. |    foundIt && behind <> (-1)    = (True, tb);
  49. |    foundIt                        = (True, SelectWindow wPtr tb);
  50.                                 = ActivateThisWindow behind wHs id tb;
  51.     where {
  52.         foundIt                                        = id == WindowDefGetWindowId wDef;
  53.         (wDef, window)                                = wH;
  54.         (wPtr, hBar, vBar, picture, updArea, zoom)    = window;
  55.     };
  56. ActivateThisWindow _ _ _ tb = (False, tb);
  57.  
  58. Open_window :: !(WindowDef s (IOState s)) !WindowPtr !Toolbox -> (!WindowHandle s, !Toolbox);
  59. Open_window wDef=:(ScrollWindow id pos title hBarDef vBarDef pictDom minSize initSize f as) behind tb
  60.     =     ((wDef`, window), tb6);
  61.     where {
  62.         (okPos, okHvalues, okVvalues, okMinSize, okInitSize, tb1)
  63.             = ValidateWindow HasControls pos pictDom hValues vValues minSize fMinSize initSize tb;
  64.         (left, top)        = okPos;
  65.         (hVal, hScroll)    = okHvalues;        (minW,  minH ) = okMinSize;
  66.         (vVal, vScroll)    = okVvalues;        (initW, initH) = okInitSize;
  67.         (pMin, pMax)    = pictDom;
  68.         (hMin, vMin)    = pMin;
  69.         (hMax, vMax)    = pMax;
  70.         wDef`            = WindowDefSetScrollBarDefs (okHvalues, okVvalues) (
  71.                                 WindowDefSetMinimumSize okMinSize (
  72.                                 WindowDefSetUpdate (Update_new f) wDef));
  73.         (wPtr, tb2)        = CreateWindow initRect title True 8 behind True CleanWindowRefCon tb1;
  74.         tb3                = SetWindowZoomState wPtr (hMin, hMax) (vMin, vMax) tb2;
  75.         hBar            = (hControl, hScroll, hMax);
  76.         vBar            = (vControl, vScroll, vMax);
  77.         (hControl, tb4)    = NewControl wPtr hBarBox "" True hVal hMin hMax` 16 0 tb3;
  78.         (vControl, tb5)    = NewControl wPtr vBarBox "" True vVal vMin vMax` 16 0 tb4;
  79.         hBarBox            = (-1, initH, inc initW, inc (initH + scrollW));        hMax`= hMax - initW;
  80.         vBarBox            = (initW, -1, inc (initW + scrollW), inc initH);        vMax`= vMax - initH;
  81.         tb6                = SetDefaultFont wPtr tb5;
  82.         updArea            = [((hVal, vVal), (hVal + initW, vVal + initH))];
  83.         window            = (wPtr, hBar, vBar, 0, updArea, (hVal, vVal));
  84.         initRect        = (    left`, 
  85.                             top`, 
  86.                             left`+initW+scrollW,
  87.                             top` +initH+scrollW    );
  88.         scrollW            = ScrollBarWidth;
  89.         hValues            = ScrollBarDefGetValues hBarDef;
  90.         vValues            = ScrollBarDefGetValues vBarDef;
  91.         fMinSize        = WindowDefGetFinalMinimumSize wDef;
  92.         left`            = left+WindowScreenBorder;
  93.         top`            = top +WindowScreenBorder+MenuBarWidth+TitleBarWidth;
  94.     };
  95. Open_window wDef=:(FixedWindow id pos title pictDom f as) behind tb
  96. |    initW == w && initH == h    = ((WindowDefSetUpdate (Update_new f) wDef, window), tb5);
  97.                                 = Open_window wDef` behind tb1;
  98.     where {
  99.         (okPos, okHvalues, okVvalues, okMinSize, okInitSize, tb1)
  100.             = ValidateWindow HasNoControls pos pictDom (hMin,1) (vMin,1) fMinSize fMinSize initSize tb;
  101.         (left, top)        = okPos;
  102.         (initW,initH)    = okInitSize;
  103.         (pMin, pMax)    = pictDom;
  104.         (hMin, vMin)    = pMin;
  105.         (hMax, vMax)    = pMax;
  106.         (wPtr, tb2)        = CreateWindow initRect title True 4 behind True CleanWindowRefCon tb1;
  107.         window            = (wPtr, hBar, vBar, 0, updArea, (0,0));
  108.         hBar            = (hControl, 1, hMin);
  109.         vBar            = (vControl, 1, vMin);
  110.         (hControl, tb3)    = NewControl wPtr barBox "" False hMin hMin hMin 16 0 tb2;
  111.         (vControl, tb4)    = NewControl wPtr barBox "" False vMin vMin vMin 16 0 tb3;
  112.         barBox            = (-49, -17, -1, -1);
  113.         tb5                = SetDefaultFont wPtr tb4;
  114.         updArea            = [((hMin, vMin), (hMin + initW, vMin + initH))];
  115.         initRect        = (    left`, 
  116.                             top`, 
  117.                             left`+initW,
  118.                             top` +initH    );
  119.         initSize        = (w,h);
  120.         fMinSize        = WindowDefGetFinalMinimumSize wDef;
  121.         wDef`            = ScrollWindow id pos title hBarDef vBarDef pictDom okMinSize okInitSize f as;
  122.         hBarDef            = ScrollBar (Thumb hMin) (Scroll 10);
  123.         vBarDef            = ScrollBar (Thumb vMin) (Scroll 10);
  124.         left`            = left+WindowScreenBorder;
  125.         top`             = top +WindowScreenBorder+MenuBarWidth+TitleBarWidth;
  126.         w                = hMax-hMin;
  127.         h                = vMax-vMin;
  128.     };
  129.  
  130.  
  131. SetDefaultFont :: !WindowPtr !Toolbox -> Toolbox;
  132. SetDefaultFont ptr tb = InGrafport2 ptr (QTextFont 0) tb;
  133.  
  134. CreateWindow :: !Rect !WindowTitle !Bool !Int !Int !Bool !Int !Toolbox -> (!WindowPtr, !Toolbox);
  135. CreateWindow rect title visible procID behind goAwayFlag refCon tb
  136. |    hasColorQD    = NewCWindow 0 rect title visible procID behind goAwayFlag refCon tb1;
  137.                 = NewWindow  0 rect title visible procID behind goAwayFlag refCon tb1;
  138.     where {
  139.         (hasColorQD, tb1) = HasColorQD tb;
  140.     };
  141.  
  142. Update_new :: !(UpdateFunction *s) !UpdateArea *s    ->    (!*s, ![DrawFunction]);
  143. Update_new f updArea s
  144.     =    (s`, [EraseUpdArea updArea : fs]);
  145.     where {
  146.         (s`, fs) = f updArea s;
  147.     };
  148.  
  149. EraseUpdArea :: !UpdateArea !Picture -> Picture;
  150. EraseUpdArea [rect : rects] pict = EraseUpdArea rects (EraseRectangle rect pict);
  151. EraseUpdArea _ pict = pict;
  152.  
  153. ValidateWindow ::    !Int !WindowPos !PictureDomain !(!Int,!Int) !(!Int,!Int)
  154.                     !MinimumWindowSize !MinimumWindowSize !InitialWindowSize !Toolbox
  155.     ->    (!WindowPos, !(!Int,!Int), !(!Int,!Int), !MinimumWindowSize, !InitialWindowSize, !Toolbox);
  156. ValidateWindow    type
  157.                 pos        =:(left, top)
  158.                 domain    =:((hMin,vMin),(hMax,vMax))
  159.                 hValues    =:(hVal, hScroll)
  160.                 vValues    =:(vVal, vScroll)
  161.                 minSize    =:(minW, minH)
  162.                 fMinSize=:(fMinW,fMinH)
  163.                 initSize=:(initW,initH)
  164.                 tb
  165. |    hMin >= hMax || vMin >= vMax || dH < fMinW || dV < fMinH
  166.     =    WindowOpenError "ValidateWindow" "WindowDefinition has illegal PictureDomain";
  167.     =    (pos`, hValues`, vValues`, minSize`, initSize`, tb1);
  168.     where {
  169.         pos`                    = (Max 0 (Min left sH), Max 0 (Min top sV));
  170.         hValues`                = (hVal`, hScroll`);
  171.         vValues`                = (vVal`, vScroll`);
  172.         modhVal                    = Align_thumb hVal hMin hMax` hScroll`;
  173.         modvVal                    = Align_thumb vVal vMin vMax` vScroll`;
  174.         minSize`                = (minW``, minH``);
  175.         minW`                    = Min minW initW`;
  176.         minH`                    = Min minH initH`;
  177.         initSize`                = (initW`, initH`);
  178.         dH`                        = Min dH sH;
  179.         dV`                        = Min dV sV;
  180.         dH                        = hMax - hMin;
  181.         dV                        = vMax - vMin;
  182.         hScroll`                = Max 1 (Min hScroll dH);
  183.         vScroll`                = Max 1 (Min vScroll dV);
  184.         sH                        = sR - (scrollW + dScrwW);
  185.         sV                        = sB - (dScrwW + scrollW + TitleBarWidth + MenuBarWidth);
  186.         scrollW                    = If (type == HasControls) ScrollBarWidth 0;
  187.         dScrwW                    = 2 * WindowScreenBorder;
  188.         (sL,sT, sR,sB, tb1)        = QScreenRect tb;
  189.         hVal`                    = Max hMin (Min modhVal hMax`);
  190.         hMax`                    = hMax - initW`;
  191.         vVal`                    = Max vMin (Min modvVal vMax`);
  192.         vMax`                    = vMax - initH`;
  193.         minW``                    = Max minW` fMinW;
  194.         minH``                    = Max minH` fMinH;
  195.         initW`                    = Min initW dH`;
  196.         initH`                    = Min initH dV`;
  197.     };
  198.